home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / fd200.zip / FD_COLOR.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-27  |  2KB  |  100 lines
  1. procedure Brite_color;
  2. begin
  3.   textbackground(brite_b);
  4.   textcolor(brite_f);
  5. end;
  6.  
  7. procedure normcolor;
  8. begin
  9.   textbackground(norm_b);
  10.   textcolor(norm_f);
  11. end;
  12.  
  13. const _vid_mode : integer = -1;
  14.  
  15. procedure get_vid_mode;
  16. var regs : registers;
  17. begin
  18.   regs.ax := $0F00;
  19.   intr($10,regs);
  20.   _vid_mode := regs.ax AND $FF;
  21. end;
  22.  
  23. procedure video_disable;
  24. begin
  25.   repeat until (Port[$03DA] AND 8 = 8);
  26.   Port[$03D8] := $25;
  27. end;
  28.  
  29. procedure video_enable;
  30. begin
  31.   case _vid_mode of
  32.     2 : Port[$03D8] := $2D;
  33.     3 : Port[$03D8] := $29;
  34.   end;
  35. end;
  36.  
  37.  
  38. procedure save_screen;
  39. begin
  40.   old_x := WhereX;
  41.   old_y := WhereY;
  42.   video_disable;
  43.   move(video, save_image , 4000);
  44.   video_enable;
  45. end;
  46.  
  47. procedure restore_screen;
  48. begin
  49.   window(1,1,80,25);
  50.   video_disable;
  51.   move(save_image, video, 4000);
  52.   video_enable;
  53.   gotoxy(old_x,old_y);
  54. end;
  55.  
  56. procedure save_entry_screen;
  57. begin
  58.   if _vid_mode = -1 then get_vid_mode;
  59.   curs_x := whereX;
  60.   curs_y := whereY;
  61.   video_disable;
  62.   move(video,screen1,4000);
  63.   video_enable;
  64. end;
  65.  
  66. procedure restore_entry_screen;
  67. begin
  68.   video_disable;
  69.   move(screen1,video,4000);
  70.   video_enable;
  71.   window(1,1,80,25);
  72.   gotoxy(curs_x,curs_y);
  73. end;
  74.  
  75. procedure save_attr(var f,b : integer; x1,y1: integer);
  76. var attr : integer;
  77. begin
  78.   video_disable;
  79.   attr := video[ (x1 + WhereX - 2)*2 + (y1 + WhereY - 2)*160 + 1 ];
  80.   video_enable;
  81.   f := attr AND $0F;
  82.   b := (attr SHR 4) AND $0F;
  83. end;
  84.  
  85. procedure restore_attr(f,b : integer);
  86. begin
  87.   textcolor(f);
  88.   textbackground(b);
  89. end;
  90.  
  91. procedure hide_cursor;
  92. var regs : registers;
  93. begin
  94.   regs.bx := 0;
  95.   regs.dx := 25 SHL 8 ;
  96.   regs.ax := $0200;
  97.   intr($10,regs);
  98. end;
  99.  
  100.